home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Wonky Flux Batch 2019 02
/
Wonky_Flux_Batch_2019-02.zip
/
Wonky Flux Batch 2019-02
/
071 - EXFER 4.1 4.2.dsk
/
EXFER.AUX.S
< prev
next >
Wrap
Text File
|
2019-02-17
|
17KB
|
469 lines
; *****************************
;
; EXfer:
; The Extended Transfer Module
;
; This program is for use on
; the ProDOS version of GBBS
; "Pro" 1.2 or "Pro" 1.3.
;
; Written by: Mike Golaszewski
; (C)1986, All Rights Reserved
;
; ****************************
; THIS IS NOT FREEWARE
; auxilliary function segment, version 4.1
; created 08/22/86 - modified 11/09/87
; A very warm "thank you" goes to the following people: Jerry Cline, for all
; of his suggestions and for providing me with a development system while out
; in Phoenix; Steve Playford, for giving EXfer a new home and taking some
; tremendous pressure off of my back; Keith Christian for his contributions,
; input, and all the laughs. Of course, thanks to Greg Schaefer too.
on nocar goto terminate
push return
if i$="C" goto copy
if i$="H" goto help
if i$="K" goto kill
if i$="M" goto message
if i$="V" goto view
if i$="W" goto wallet
if i$="#" goto retype
; return to the main EXfer segment
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
return
link "a:exfer.seg","prompt"
; show credits available and library info
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
wallet
print 'Your wallet has 'cr' credits...
Uploads to this library pay 'um' credits
per kilobyte ; downloads cost 'dm' credits
per kilobyte.
Current protocol: ' ;:if pt print "Ymodem batch"
if xm=0 print "Xmodem Standard":else if xm=1 print "Xmodem ProDOS"
if xm=2 print "Xmodem DOS":else if xm=3 print "ASCII"
return
; display help on a command
; ~~~~~~~~~~~~~~~~~~~~~~~~~
help
input @2 "Help on which command: " i$:if i$="" return
x$="CDFHIKLMNRSTVX?B":x=instr(i$,x$):if x=0 return
ready "a1:hlp.exfer":print \s$\:input #msg(x),a,x$
input #6,x$:setint(1):print x$\:copy #6:setint("")
ready d2$:return
; message to librarian
; ~~~~~~~~~~~~~~~~~~~~
message
print screen$"Enter feedback: ["edit(3)"] cols, [4K] Max"
print "[DONE] when finished, [.H] for help":edit(0)
edit(1):if not(edit(2)) then return:else ready "a:mail"
d=b1:if not(d) then d=1
if info(6)<29 print \"XT: Bit-map full":ready d2$:return
print #msg(d),un:print #6,"EXfer: Feedback from a user"\
print #6,"From ->"a1$" "a2$" [#"un"]"
print #6,"Date ->"date$" "time$\:copy #8,#6
print #msg(d),chr$(4);chr$(0);
msg(d)=1:update:ready d2$:return
; view a file
; ~~~~~~~~~~~
view
if not(b3) goto lsec
input @2 "View: " i$:if i$="" return
if (val(i$)) or (left$(i$,1)="#") gosub nread:goto view.x
i$=left$(i$+chr$(32,14),15):gosub read
if not(l) goto nfile
view.x
if not(l) goto nfile
if not(byte(9)) print '
XT: This file must first be validated
by the sysop before it can be
accessed...':return
gosub name:f$=bf$+f$:gosub dtype
if ty$<>"TXT" print \"XT: Not a TXT type file...":return
gosub chkfil:if a close:goto nfile
print \s$\:setint(1):copy #1:close
setint(""):if not(lb) then cr=cr-((byte(10)+byte(11)*256)/2)*dm
return
; kill a file
; ~~~~~~~~~~~
; make sure the file belongs to the user
kill
input @2 "Kill: " i$:if i$="" return
if (val(i$)) or (left$(i$,1)="#") gosub nread:l=l-1:goto kill.x
i$=left$(i$+chr$(32,14),15):gosub read
if not(l) goto nfile
kill.x
if l<0 goto nfile
if lb goto kill.1:else a=byte(12)+byte(13)*256
if a<>un print \"XT: That is not your file":return
; kill the file
kill.1
gosub name:i$="Y":if info(5) input @0 \"XT: Remove file from disk ? " i$
f$=bf$+f$:x=byte(14):fill ram2+9,32,0:if i$="Y" kill f$
open #1,d1$:position #1,32,l+1:print #1,chr$(13):write #1,ram2+9,30:close
if not(v) then nibble(3)=nibble(3)-(a=un):else ul=ul-(a=un)
if not(x) goto getslt
; scan for the message containing file's information
kill.2
msg(x)=0:kill #msg(x):update:goto getslt
; copy a file
; ~~~~~~~~~~~
copy
if not(b4) goto lsec:else if nb=255 goto dfull
input @2 "Copy: " i$:if i$="" return
na$=left$(i$+chr$(32,14),15):i$=na$:gosub read
gosub name:f$=bf$+f$:gosub chkfil:close
if a and not(l) goto copy.2
if lb goto copy.1:else print '
XT: 'chr$(7)"Duplicate name on ProDOS volume":return
; see what sysop wishes to do with duplicate
copy.1
if l then nb=l
input @0 \"XT: File exists...overwrite ? " i$
if i$<>"Y" return:else kill f$
; get the text
copy.2
print screen$'
For files exceeding 4096 bytes, use the
R)eceive command...
Enter text: 'edit(3)' columns, [4K] max
[DONE] when finished, [.H] for help'
edit(0):edit(1):if not(edit(2)) return
input @0 \"XT: Is this a Ymodem list macro ? " i$
; get some info on the file
create f$:open #1,f$:copy #8,#1:close
nibble(3)=nibble(3)+1:gosub size:gosub sfile
byte(14)=0:byte(15)=0:ty$="TXT":if i$="Y" then ty$="LST"
push getslt:if nb<>byte(4) goto write:else goto update
; user has dropped carrier
; ~~~~~~~~~~~~~~~~~~~~~~~~
terminate
byte=ram2:byte(0)=xm+(8*pt):byte(1)=1:byte(2)=cr mod 256:byte(3)=cr/256
open #1,"a1:xt.users":position #1,4,un:write #1,ram2,4:close
poke ram2,v:when$=ram+20:if not(v) then byte=ram+29:goto byecon.1
byte=ram+37:nibble(3)=dl/256:byte(3)=dl mod 256
nibble(4)=ul/256:byte(4)=ul mod 256
byecon.1
print '
:::::::::::::::::::::::::::::::::::::
: EXfer v4.1 - Hackers Hotline BBS :
:::::::::::::::::::::::::::::::::::::'
flag=ram+22:clear:recall "a:variables":kill "a:variables":x=peek(ram2)
if x=13 then ul=byte(4)+nibble(4)*256:dl=byte(3)+nibble(3)*256
link "a:main.seg","term1"
; ::::::::::::::::::::
; disk I/O subroutines
; ::::::::::::::::::::
; get an empty slot
; ~~~~~~~~~~~~~~~~~
getslt
nb=0:open #1,d1$:for l=1 to byte(4)
position #1,32,l+1:input #1,i$
if (i$="") and (nb=0) then nb=l:l=byte(4)
next:close:if not(nb) then nb=byte(4)
return
; update "number of entries" counter
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
update
byte(4)=byte(4)+1:open #1,d1$:print #1,bn$
print #1,bf$:write #1,ram2,9:close
; write a directory entry
; ~~~~~~~~~~~~~~~~~~~~~~~
write
open #1,d1$:position #1,32,nb+1:print #1,na$
print #1,ty$:write #1,ram2+9,10:close
z=nb:return
; read a directory entry
; ~~~~~~~~~~~~~~~~~~~~~~
read
open #1,d1$:for l=1 to byte(4)
position #1,32,l+1:input #1,f$
if instr(i$,f$)=1 then p=l:l=byte(4):next:l=p:goto read.1
next:close #1:l=0:return
read.1
input #1,ty$:read #1,ram2+9,10:close #1
return
; read a file by slot #
; ~~~~~~~~~~~~~~~~~~~~~
nread
if left$(i$,1)="#" then i$=mid$(i$,2)
l=val(i$):if (l<2) or (l>253) then l=0:return
open #1,d1$:position #1,32,l
input #1,f$:if f$="" close #1:l=0:return
input #1,ty$:read #1,ram2+9,10:close #1
i$=f$:if pt=2 return:else print \"XT: [#"l"]: "i$:return
; find the type of a file
; ~~~~~~~~~~~~~~~~~~~~~~~
dtype
use "a1:xtyp",f$:x=peek(ram2+32)
x$="???0TXT4PDA5BIN6ADB25AWP26ASP27SRC176OBJ177LIB178S16179RTL180EXE181"
x$=x$+"STR182RIF183NDA184CDA185SET186PNT192PIC193ANI194$DD221PAS239CMD240"
x$=x$+"COM245P16249BAS252VAR253REL254SYS255"
ty$="":y=instr(str$(x),x$):if y then ty$=mid$(x$,y-3,3):return
ty$="$"+chr$(48+x/16+((x/16)>9)*7)+chr$(48+x mod 16+((x mod 16)>9)*7)
return
; return the size of F$ in A
; ~~~~~~~~~~~~~~~~~~~~~~~~~~
size
open #1,f$:a=size(1)/2+1:close:return
; see if file exists
; ~~~~~~~~~~~~~~~~~~
chkfil
open #1,f$:a=mark(1):return
; :::::::::::::::::::
; special subroutines
; :::::::::::::::::::
; convert to a valid ProDOS name
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; shorten I$ to directory length
name
if len(i$)>15 then i$=left$(i$,15)
i$=i$+chr$(1)
; make sure the first char is a letter
name.0
a=asc(left$(i$,1)):if a=1 pop:return
if (a>64) and (a<91) then i$=left$(i$,len(i$)-1):goto name.1
if (a>96) and (a<123) then i$=left$(i$,len(i$)-1):goto name.1
i$=mid$(i$,2):goto name.0
; remove symbols from the name
name.1
f$="":for x=1 to len(i$):a=asc(mid$(i$,x,1))
if (a>64) and (a<91) goto name.2
if (a>96) and (a<123) goto name.2
if (a>47) and (a<58) goto name.2
if a=46 goto name.2:else goto name.3
; add a valid character
name.2
f$=f$+chr$(a)
; if we dont have a name, return to the prompt
name.3
next:if f$="" pop:return
if len(f$)>15 then f$=left$(f$,15)
return
; set file information
; ~~~~~~~~~~~~~~~~~~~~
sfile
byte(9)=byte(3):byte(10)=a mod 256:byte(11)=a/256
byte(12)=un mod 256:byte(13)=un/256:byte(18)=0
when$="x":if lb then byte(9)=255
return
; ::::::::::::::
; error messages
; ::::::::::::::
lsec
print \"XT:"chr$(7)" Security too low...":return
dfull
print \"XT:"chr$(7)" Directory full...":return
nfile
print \"XT:"chr$(7)" No such file...":return
retype
i=0:input @2 "Re-type which file? [<CR>=Abort]:" i$:if i$="" return
if left$(i$,1)="?" gosub directory:print \:goto retype
if (val(i$)) or (left$(i$,1)="#") gosub nread:goto retype2
i$=left$(i$+chr$(32,14),15):gosub read
if l=0 goto nfile
retype2
print \" Current type: "ty$
input @2 "New type [0-255]: " re$:if re$="" return
if re$="?" copy "a1:f.types":goto retype2
x=val(re$)
if (x>255) or (x<0) return
if (x>249) and (x<252) return
if (x>245) and (x<249) return
if (x>240) and (x<245) return
if (x>221) and (x<239) return
if (x>200) and (x<221) return
if (x>194) and (x<200) return
if (x>186) and (x<192) return
if (x>27) and (x<176) return
if (x>6) and (x<25) return
if (x>0) and (x<4) return
if x<>6 goto retype3
print '
(1> BIN (regular binary)
(2> BNY (binary II)
(3> BQY (binary II squeezed)
(4> SQZ (squeezed only)';:input @2\"Which? [1-4] [<CR>=Abort]:" re$
i=val(re$):if (i<1) and (i>4) print \"Aborted...":return
retype3
a$=f$:f$=bf$+f$
gosub type
gosub dtype
f$=a$
if i=1 then ty$="BIN"
if i=2 then ty$="BNY"
if i=3 then ty$="BQY"
if i=4 then ty$="SQZ"
open #1,d1$:position #1,32,l:print #1,f$
print #1,ty$:write #1,ram2+9,10:close
input @2\"Another? [Y/<N>]:" i$:if left$(i$,1)<>"Y" return
print \:goto retype
; :::::::::::::::::::
; library subroutines
; :::::::::::::::::::
; catalog a library
; ~~~~~~~~~~~~~~~~~
; print directory headers
directory
if not(b3) goto lsec
print screen$:gosub dir.h:use "a1:xtyp",bf$
; grab an entry
open #1,d1$:for l=1 to byte(4):f$=""
position #1,32,l+1:input #1,f$:input #1,ty$
position #1,32,l+1,20:read #1,ram2+9,10:if f$="" goto dir.1
setint(1)
; if its valid, print it
gosub dir.e:print:if byte(9) goto dir.1
if (not(byte(9))) and (not(lb)) goto dir.1
; update if not validated
print chr$(7,3);"** Validate above file [Y/N/K] ? ";:get i$
print chr$(8,35);chr$(32,35);chr$(8,35)
if i$="Y" position #1,32,l+1,20:print #1,chr$(255);
if i$<>"K" goto dir.1:else position #1,32,l+1:fill ram2+9,31,0
print #1,chr$(13):write #1,ram2+9,30:i$=f$:gosub name
kill f$:if l<nb then nb=l
dir.1
if key(1) then l=byte(4)
next:close:setint("")
x=peek(865)+peek(866)*256:y=peek(867)+peek(868)*256
z=x-y:print \chr$(14)"Kbytes Free: "left$(str$(z)+chr$(32,4),5);
print " " ;right$(" Kbytes Used: "+str$(y),19);
if edit(3)>39 print chr$(32,9)"Total Kbytes: "x:else print
return
; :::::::::::::::::::::
; directory subroutines
; :::::::::::::::::::::
; show a directory header
dir.h
print right$("00"+str$(bb),3)": "bn$;
if edit(3)>39 print chr$(32,22)"Librarian:";
print " "right$("00"+str$(b1),3)\\" # Filename Type ";
if edit(3)<79 print "Size Dated Cost"\:return
print "I Size Uploaded Uploader Dnloaded Credits Misc"\
return
; show a directory entry
dir.e
print right$("00"+str$(l+1),3)" "f$" "ty$" ";:if edit(3)<79 goto dir.x
if byte(14) print "Y ";:else print "N ";
dir.x
x=byte(10)+byte(11)*256:print right$(" "+str$(x),4)" ";
b$=when$:a$=right$(b$,3)+left$(b$,5):y=byte(18):x=byte(12)+byte(13)*256
if edit(3)<79 goto dir.40
if not(byte(9)) poke 50,255:print chr$(15)"VALIDATE"chr$(14);:poke 50,0
if (byte(9)) and (lc$>a$) print b$;:goto dir.c
if not(byte(9)) goto dir.c
poke 50,255:print chr$(15)"NEW FILE"chr$(14);:poke 50,0
dir.c
print " User "right$("00"+str$(x),3)" "right$(" "+str$(y),3)" times ";
x=((byte(10)+byte(11)*256)/2)*dm:print right$(" "+str$(x),7)" ";
if lc$<=a$ print "NEW";
return
dir.40
if not(byte(9)) print " VAL ";
if (lc$>a$) and (byte(9)) print left$(b$,5);:else if byte(9) print " NEW ";
x=((byte(10)+byte(11)*256)/2)*dm:if cr>=x print "$";:else print " ";
print right$(" "+str$(x),4);:return
; set the type of a file
; ~~~~~~~~~~~~~~~~~~~~~~
type
use "a1:xtyp",f$,x:return